home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / database / jbcalc10 / jbprocs.prg < prev    next >
Text File  |  1988-01-16  |  4KB  |  79 lines
  1. * JBPROCS.PRG
  2. PARAMETERS JBKEYHIT
  3. DO CASE
  4.      CASE JBKEYHIT$'0123456789.'               && .AND. JBTYPE = " DEC "
  5.                IF JBOPER$'='
  6.                     STORE JBCURR TO JBCURRA
  7.                     STORE "0" TO JBCURR
  8.                     STORE " " TO JBOPER
  9.                ENDIF
  10.           DO CASE
  11.                case jbcurr = "0." .AND. JBKEYHIT <> "."
  12.                     STORE JBCURR+JBKEYHIT TO JBCURR
  13.                     @ JABTOP+3,JABLEFT+5  SAY SPACE(20-LEN(JBCURR))+JBCURR+" "
  14.                CASE JBCURR = "0" .AND. JBKEYHIT <> "."
  15.                     STORE JBKEYHIT TO JBCURR
  16.                     @ JABTOP+3,JABLEFT+5  SAY SPACE(20-LEN(JBCURR))+JBCURR+" "
  17.                CASE JBCURR = "0" .AND. JBKEYHIT = "."
  18.                     STORE "0." TO JBCURR
  19.                     @ JABTOP+3,JABLEFT+5  SAY SPACE(20-LEN(JBCURR))+JBCURR+" "
  20.                CASE LEN(JBCURR) = 1 .AND. JBKEYHIT = "."
  21.                     STORE JBCURR+'.' TO JBCURR
  22.                     @ JABTOP+3,JABLEFT+5  SAY SPACE(20-LEN(JBCURR))+JBCURR+" "
  23.                CASE LEN(JBCURR) < 20
  24.                     STORE JBCURR+JBKEYHIT TO JBCURR
  25.                     call ascroll with chr(1),chr(1),chr(15),chr(JABTOP+3),chr(JABLEFT+5),chr(JABTOP+3),chr(JABLEFT+24)
  26.                     @ JABTOP+3,JABLEFT+24 SAY JBKEYHIT
  27.                CASE LEN(JBCURR) >= 20
  28.                     SET COLOR TO N*/W
  29.                     @ JABTOP+3,JABLEFT+2 SAY "E"
  30.                     SET COLOR TO N/W
  31.           ENDCASE
  32.      CASE LOWER(JBKEYHIT)=" √x"                  &&  .AND. JBTYPE = " DEC "
  33.           STORE IF(VAL(JBCURR)>=0,SQRT(VAL(JBCURR)),(-1*SQRT(-1*VAL(JBCURR))))TO JBCURR
  34.           STORE LTRIM(TRIM(STR(JBCURR,18,8))) TO JBCURR
  35.           @ JABTOP+3,JABLEFT+5  SAY SPACE(20-LEN(JBCURR))+JBCURR+" "
  36.      CASE JBKEYHIT="LOG"                         &&  .AND. JBTYPE = " DEC "
  37.           STORE IF(VAL(JBCURR)>=0,LOG(VAL(JBCURR)),(-1*LOG(-1*VAL(JBCURR))))TO JBCURR
  38.           STORE LTRIM(TRIM(STR(JBCURR,18,8))) TO JBCURR
  39.           @ JABTOP+3,JABLEFT+5  SAY SPACE(20-LEN(JBCURR))+JBCURR+" "
  40.      CASE JBKEYHIT='EXP'                         &&  .AND. JBTYPE = " DEC "
  41.           STORE IF(VAL(JBCURR)>=0,EXP(VAL(JBCURR)),(-1*EXP(-1*VAL(JBCURR))))TO JBCURR
  42.           STORE LTRIM(TRIM(STR(JBCURR,18,8))) TO JBCURR
  43.           @ JABTOP+3,JABLEFT+5  SAY SPACE(20-LEN(JBCURR))+JBCURR+" "
  44.      CASE JBKEYHIT$' π '                         &&  .AND. JBTYPE = " DEC "
  45.           STORE "3.142857143" TO JBCURR
  46.           @ JABTOP+3,JABLEFT+1  SAY SPACE(13)+JBCURR
  47.      CASE JBKEYHIT$'%'                           && .AND. JBTYPE = " DEC "
  48.           DO CASE
  49.                CASE LEN(JBCURR) >= 18 .AND. AT('.',JBCURR) = 0
  50.                CASE LEN(JBCURR) >= 18 .AND. AT('.',JBCURR) <> 0
  51.                CASE AT('.',JBCURR) = 0
  52.                     DO CASE
  53.                          CASE LEN(JBCURR) = 1
  54.                               STORE "0.0"+SUBSTR(JBCURR,1,1) TO JBCURR
  55.                          CASE LEN(JBCURR) = 2
  56.                               STORE "0."+SUBSTR(JBCURR,1,2) TO JBCURR
  57.                          CASE LEN(JBCURR) = 3
  58.                               STORE SUBSTR(JBCURR,1,1)+'.'+SUBSTR(JBCURR,2,2) TO JBCURR
  59.                          OTHERWISE
  60.                               STORE SUBSTR(JBCURR,1,LEN(JBCURR)-2)+'.'+SUBSTR(JBCURR,LEN(JBCURR)-2,LEN(JBCURR)) TO JBCURR
  61.                     ENDCASE
  62.                CASE AT('.',JBCURR) >= 3
  63.                     STORE AT('.',JBCURR) TO JBPOS
  64.                     STORE SUBSTR(JBCURR,1,LEN(JBCURR)-(LEN(JBCURR)-(JBPOS-3)))+'.'+SUBSTR(JBCURR,JBPOS-2,2)+SUBSTR(JBCURR,JBPOS+1) TO JBCURR
  65.                CASE AT('.',JBCURR) = 2
  66.                     STORE AT('.',JBCURR) TO JBPOS
  67.                     IF SUBSTR(JBCURR,1,1) = "0"
  68.                           STORE "0.0"+SUBSTR(JBCURR,1,1)+SUBSTR(JBCURR,JBPOS+1) TO JBCURR
  69.                     ELSE
  70.                           STORE "0.0"+SUBSTR(JBCURR,1,1)+SUBSTR(JBCURR,JBPOS+1) TO JBCURR
  71.                     ENDIF
  72.                CASE AT('.',JBCURR) = 1
  73.                     STORE AT('.',JBCURR) TO JBPOS
  74.                     STORE "0.00"+SUBSTR(JBCURR,1,JBPOS-1)+SUBSTR(JBCURR,JBPOS+1,LEN(JBCURR)) TO JBCURR
  75.           ENDCASE
  76.           @ JABTOP+3,JABLEFT+5  SAY SPACE(20-LEN(JBCURR))+JBCURR+" "
  77. ENDCASE
  78. RETURN
  79.